home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch1 / RubrBox.frm (.txt) < prev    next >
Visual Basic Form  |  1999-03-19  |  2KB  |  76 lines
  1. VERSION 5.00
  2. Begin VB.Form frmRubrBox 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "RubrBox"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   1140
  7.    ClientTop       =   1515
  8.    ClientWidth     =   6690
  9.    LinkTopic       =   "Form1"
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   4140
  12.    ScaleWidth      =   6690
  13. Attribute VB_Name = "frmRubrBox"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = False
  16. Attribute VB_PredeclaredId = True
  17. Attribute VB_Exposed = False
  18. Option Explicit
  19. Private Rubberbanding As Boolean
  20. Private OldMode As Integer
  21. Private OldStyle As Integer
  22. Private FirstX As Single
  23. Private FirstY As Single
  24. Private LastX As Single
  25. Private LastY As Single
  26. ' Start rubberbanding.
  27. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  28.     ' Let MouseMove know we are rubberbanding.
  29.     Rubberbanding = True
  30.     ' Save values so we can restore them later.
  31.     OldMode = DrawMode
  32.     OldStyle = DrawStyle
  33.     DrawMode = vbInvert
  34.     DrawStyle = vbDot
  35.     ' Save the starting coordinates.
  36.     FirstX = X
  37.     FirstY = Y
  38.     ' Draw the initial rubberband box.
  39.     LastX = X
  40.     LastY = Y
  41.     Line (FirstX, FirstY)-(LastX, LastY), , B
  42. End Sub
  43. ' Continue rubberbanding.
  44. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  45.     ' If we are not rubberbanding, do nothing.
  46.     If Not Rubberbanding Then Exit Sub
  47.     ' Erase the previous rubberband box.
  48.     Line (FirstX, FirstY)-(LastX, LastY), , B
  49.     ' Draw the new rubberband box.
  50.     LastX = X
  51.     LastY = Y
  52.     Line (FirstX, FirstY)-(LastX, LastY), , B
  53. End Sub
  54. ' Stop rubberbanding.
  55. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  56. Dim oldfill As Integer
  57. Dim oldcolor As Long
  58.     ' If we are not rubberbanding, do nothing.
  59.     If Not Rubberbanding Then Exit Sub
  60.     ' We are no longer rubberbanding.
  61.     Rubberbanding = False
  62.     ' Erase the previous rubberband box.
  63.     Line (FirstX, FirstY)-(LastX, LastY), , B
  64.     ' Restore the original DrawMode and DrawStyle.
  65.     DrawMode = OldMode
  66.     DrawStyle = OldStyle
  67.     ' Fill the final box with a random color.
  68.     oldfill = FillStyle
  69.     oldcolor = FillColor
  70.     FillStyle = vbSolid
  71.     FillColor = QBColor(Int(Rnd * 16))
  72.     Line (FirstX, FirstY)-(LastX, LastY), , B
  73.     FillStyle = oldfill
  74.     FillColor = oldcolor
  75. End Sub
  76.